1 Introduction!

We’re going to explore relationships between political affiliation, demographics, and COVID-19 statistics. To do this, I’ve pulled together subsets of data from the New York Times’ COVID-19 dataset, the MIT Election Data and Science Lab’s County Presidential Election Returns 2000-2016 dataset, and 2016 data from the US Census.

We also add datasets compiled by [@evangambit](https://github.com/evangambit/JsonOfCounties), including CDC mortality statistics by county, unemployment by county, and preliminary 2020 Presidential election votes by county.

2 Data Preparation

All data is by State and County, so we’ll join all datasets together and select only the columns of interest.

2.1 Loading in the data

We will now load in all required .csv data files, starting with the COVID-19 dataset. We only select the week leading up to Election 2020 and we compute average new cases and deaths by county.

# set working directory
setwd("data")

# COVID-19 average cases and deaths by state and county in week leading up to 2020 election
data_counties <- read.csv("us-counties.csv") %>%
  filter(date >= '2020-10-28') %>%
  filter(date <= '2020-11-03') %>%
  group_by(state, county, fips) %>%
  dplyr::summarize(cases_avg = mean(cases), deaths_covid_avg = mean(deaths)) %>%
  select(state, county, fips, cases_avg, deaths_covid_avg)

Load the Mask Use dataset and calculate a compsite measure. This dataset contains responses, by county, for percentages of people who report wearing masks “Always”, “Frequently”, “Sometimes”, “Rarely”, and “Never” We define

\[MaskPercentCompliance = ALWAYS + \frac{3}{4}FREQUENTLY + \frac{1}{2}SOMETIMES + \frac{1}{4}RARELY\]

to be the weighted average of these responses. Let’s join this dataset to our COVID-19 data.

setwd("data")
# join mask attitudes data
data_counties <- join(data_counties,
                      read.csv("./mask-use/mask-use-by-county.csv") %>%
                        rename(fips = COUNTYFP) %>%
                        mutate(mask_pct_compliance = (ALWAYS + 0.75*FREQUENTLY + 0.5*SOMETIMES + 0.25*RARELY)),
                      by = "fips",
                      type = "left")

We now load demographics data for each county in the United States in 2016 so that we can temporally compare to the elections data that we’ll load in next. Once again, we’ll join this to our county table.

setwd("data")
# join 2016 demographics data
data_counties <- join(data_counties,
                      read.csv("./us-counties-census-data/cc-est2019-alldata-2016-20subset.csv") %>%
                        filter(YEAR == "2016") %>%
                        mutate(white_pct_2016 = (WA_MALE + WA_FEMALE) / TOT_POP) %>%
                        mutate(hispanic_pct_2016 = (H_MALE + H_FEMALE) / TOT_POP) %>%
                        mutate(afra_black_pct_2016 = (BAC_MALE + BAC_FEMALE) / TOT_POP) %>%
                        rename(state = STNAME) %>%
                        mutate(county = str_replace(CTYNAME, " County", "")) %>%
                        rename(population_2016 = TOT_POP) %>%
                        select(state, county, population_2016, white_pct_2016,
                               hispanic_pct_2016, afra_black_pct_2016),
                      by = c("state", "county"),
                      type = "left")
# join 2019 demographics data
data_counties <- join(data_counties,
                      read.csv("./us-counties-census-data/cc-est2019-alldata-2016-20subset.csv") %>%
                        filter(YEAR == "2019") %>%
                        mutate(white_pct_2019 = (WA_MALE + WA_FEMALE) / TOT_POP) %>%
                        mutate(hispanic_pct_2019 = (H_MALE + H_FEMALE) / TOT_POP) %>%
                        mutate(afra_black_pct_2019 = (BAC_MALE + BAC_FEMALE) / TOT_POP) %>%
                        rename(state = STNAME) %>%
                        mutate(county = str_replace(CTYNAME, " County", "")) %>%
                        rename(population_2019 = TOT_POP) %>%
                        select(state, county, population_2019, white_pct_2019,
                               hispanic_pct_2019, afra_black_pct_2019),
                      by = c("state", "county"),
                      type = "left")

We’ll also load some unemployment demographics.

setwd("data")
# join 2016 unemployment demographics data
data_counties <- join(data_counties,
                      read.csv("./us-counties-2020-election-unemployment-mortality/unemployment/2016.csv") %>%
                        rename(state = State) %>%
                        rename(county = County) %>%
                        rename(labour_force_2016 = LabourForce) %>%
                        mutate(unemployment_2016 = Unemployed / labour_force_2016) %>%
                        select(state, county, labour_force_2016, unemployment_2016),
                      by = c("state", "county"),
                      type = "left")
# join 2019 unemployment demographics data
data_counties <- join(data_counties,
                      read.csv("./us-counties-2020-election-unemployment-mortality/unemployment/2019.csv") %>%
                        rename(state = State) %>%
                        rename(county = County) %>%
                        rename(labour_force_2019 = LabourForce) %>%
                        mutate(unemployment_2019 = Unemployed / labour_force_2019) %>%
                        select(state, county, labour_force_2019, unemployment_2019),
                      by = c("state", "county"),
                      type = "left")

And police shootings data.

setwd("data")
# join 2017 police shootings data
data_counties <- join(data_counties,
                      read.csv("./us-counties-2020-election-unemployment-mortality/police-shootings/police_shootings.csv") %>%
                        filter(year == "2017") %>%
                        filter(status == "armed") %>%
                        mutate(police_shootings_armed_2017 = count) %>%
                        mutate(county = tools::toTitleCase(str_replace(county, " county", ""))) %>%
                        select(state, county, police_shootings_armed_2017),
                      by = c("state", "county"),
                      type = "left")
data_counties <- join(data_counties,
                      read.csv("./us-counties-2020-election-unemployment-mortality/police-shootings/police_shootings.csv") %>%
                        filter(year == "2017") %>%
                        filter(status == "unarmed") %>%
                        mutate(police_shootings_unarmed_2017 = count) %>%
                        mutate(county = tools::toTitleCase(str_replace(county, " county", ""))) %>%
                        select(state, county, police_shootings_unarmed_2017),
                      by = c("state", "county"),
                      type = "left")
# join 2019 police shootings data
data_counties <- join(data_counties,
                      read.csv("./us-counties-2020-election-unemployment-mortality/police-shootings/police_shootings.csv") %>%
                        filter(year == "2019") %>%
                        filter(status == "armed") %>%
                        mutate(police_shootings_armed_2019 = count) %>%
                        mutate(county = tools::toTitleCase(str_replace(county, " county", ""))) %>%
                        select(state, county, police_shootings_armed_2019),
                      by = c("state", "county"),
                      type = "left")
data_counties <- join(data_counties,
                      read.csv("./us-counties-2020-election-unemployment-mortality/police-shootings/police_shootings.csv") %>%
                        filter(year == "2019") %>%
                        filter(status == "unarmed") %>%
                        mutate(police_shootings_unarmed_2019 = count) %>%
                        mutate(county = tools::toTitleCase(str_replace(county, " county", ""))) %>%
                        select(state, county, police_shootings_unarmed_2019),
                      by = c("state", "county"),
                      type = "left")

And deaths by assault and deaths by suicide. These statistics represent cumulative deaths by county between 1999 and 2016. We estimate a yearly rate by normalizing by current county population, then dividing by (2016-1999+1).

setwd("data")
# join deaths by assault and suicide
data_counties <- join(data_counties,
                      read.csv("./us-counties-2020-election-unemployment-mortality/mortality-cdc/mortality-1999-2016.csv") %>%
                        rename(fips = FIPS) %>%
                        replace(.=="Suppressed", NA) %>%
                        rename(deaths_assault = DeathAssault) %>%
                        rename(deaths_suicide = DeathSuicide) %>%
                        select(fips, deaths_assault, deaths_suicide),
                      by = "fips",
                      type = "left")
# refactor death statistics as numeric
data_counties$deaths_assault <- as.numeric(data_counties$deaths_assault)
data_counties$deaths_suicide <- as.numeric(data_counties$deaths_suicide)
data_counties <- data_counties %>%
  mutate(norm_deaths_assault_avg = deaths_assault / (18*population_2019)) %>%
  mutate(norm_deaths_suicide_avg = deaths_suicide / (18*population_2019))

Lastly, we load in data for the 2016 Presidential Election by county. We create a new composite measure

\[RepublicanPercent2016 = \frac{CandidateVotes_{Republican}}{TotalVotes}\] of the percentage of votes in that county that were Republican (Trump) in 2016.

setwd("data")
# join 2016 presidential elections data
data_counties <- join(data_counties,
                      read.csv("./us-counties-2016-election/countypres_2000-2016.csv") %>%
                        filter(year == '2016') %>%
                        filter(party == "republican") %>%
                        rename(fips = FIPS) %>%
                        mutate(republican_pct_2016 = candidatevotes / totalvotes) %>%
                        select(fips, republican_pct_2016),
                      by = "fips",
                      type = "left")
# join 2020 presidential elections data
data_counties <- join(data_counties,
                      read.csv("./us-counties-2020-election-unemployment-mortality/election2020.csv") %>%
                        mutate(republican_pct_2020 = votes_gop / votes_total) %>%
                        mutate(county = tools::toTitleCase(str_replace(county, " county", ""))) %>%
                        select(state, county, republican_pct_2020),
                      by = c("state", "county"),
                      type = "left")

We select only the attributes of interest. Let’s have a look at our data!

data_counties <- data_counties %>%
  mutate(norm_cases_avg = cases_avg / population_2019) %>%
  mutate(norm_deaths_covid_avg = deaths_covid_avg / population_2019) %>%
  select(state, county, mask_pct_compliance, norm_cases_avg, norm_deaths_covid_avg,
         norm_deaths_assault_avg, norm_deaths_suicide_avg, population_2016,
         population_2019, white_pct_2016, white_pct_2019, hispanic_pct_2016,
         hispanic_pct_2019, afra_black_pct_2016, afra_black_pct_2019, republican_pct_2016,
         republican_pct_2020, labour_force_2016, labour_force_2019, unemployment_2016,
         unemployment_2019, police_shootings_armed_2017, police_shootings_armed_2019,
         police_shootings_unarmed_2017, police_shootings_unarmed_2019)
data_counties

Let’s check the zero-order correlations of our variables of interest :)

cor(na.omit(data_counties[3:25]))
##                               mask_pct_compliance norm_cases_avg
## mask_pct_compliance                   1.000000000    -0.20315894
## norm_cases_avg                       -0.203158945     1.00000000
## norm_deaths_covid_avg                 0.157276484     0.52844813
## norm_deaths_assault_avg              -0.004926727     0.35367942
## norm_deaths_suicide_avg              -0.400160308    -0.14750810
## population_2016                       0.361013892     0.05624066
## population_2019                       0.365634260     0.05484626
## white_pct_2016                       -0.157976885    -0.24718559
## white_pct_2019                       -0.166318786    -0.23639077
## hispanic_pct_2016                     0.516140332     0.23869146
## hispanic_pct_2019                     0.518756651     0.23936841
## afra_black_pct_2016                   0.073225796     0.31006820
## afra_black_pct_2019                   0.074715066     0.30622994
## republican_pct_2016                  -0.529282821     0.02957923
## republican_pct_2020                  -0.548642838     0.07920158
## labour_force_2016                     0.361674336     0.04793362
## labour_force_2019                     0.362502263     0.04662571
## unemployment_2016                     0.084576560     0.15024747
## unemployment_2019                     0.118224325     0.15908124
## police_shootings_armed_2017           0.207393368     0.06176752
## police_shootings_armed_2019           0.237397695     0.06889112
## police_shootings_unarmed_2017         0.144658528     0.03659297
## police_shootings_unarmed_2019         0.139061876    -0.02493795
##                               norm_deaths_covid_avg norm_deaths_assault_avg
## mask_pct_compliance                      0.15727648            -0.004926727
## norm_cases_avg                           0.52844813             0.353679423
## norm_deaths_covid_avg                    1.00000000             0.374839792
## norm_deaths_assault_avg                  0.37483979             1.000000000
## norm_deaths_suicide_avg                 -0.17772226             0.033422221
## population_2016                          0.07377755             0.153430030
## population_2019                          0.07017525             0.148027580
## white_pct_2016                          -0.29399492            -0.722108101
## white_pct_2019                          -0.28618408            -0.709630000
## hispanic_pct_2016                        0.26762922            -0.032260583
## hispanic_pct_2019                        0.26676682            -0.034888035
## afra_black_pct_2016                      0.31076784             0.777709217
## afra_black_pct_2019                      0.30594912             0.770211659
## republican_pct_2016                     -0.16761899            -0.298834812
## republican_pct_2020                     -0.10809677            -0.292479696
## labour_force_2016                        0.06544157             0.143956665
## labour_force_2019                        0.05927223             0.135621510
## unemployment_2016                        0.29552998             0.352616972
## unemployment_2019                        0.31567052             0.358719533
## police_shootings_armed_2017              0.01060301             0.201348694
## police_shootings_armed_2019              0.01784940             0.149967419
## police_shootings_unarmed_2017            0.02287339             0.161204624
## police_shootings_unarmed_2019            0.02295459             0.083172597
##                               norm_deaths_suicide_avg population_2016
## mask_pct_compliance                       -0.40016031      0.36101389
## norm_cases_avg                            -0.14750810      0.05624066
## norm_deaths_covid_avg                     -0.17772226      0.07377755
## norm_deaths_assault_avg                    0.03342222      0.15343003
## norm_deaths_suicide_avg                    1.00000000     -0.28612443
## population_2016                           -0.28612443      1.00000000
## population_2019                           -0.28988959      0.99964016
## white_pct_2016                             0.27246084     -0.22616779
## white_pct_2019                             0.28048127     -0.22677114
## hispanic_pct_2016                         -0.30956084      0.30045896
## hispanic_pct_2019                         -0.31173974      0.29813545
## afra_black_pct_2016                       -0.27574649      0.11047129
## afra_black_pct_2019                       -0.27822790      0.10651539
## republican_pct_2016                        0.37621202     -0.42279204
## republican_pct_2020                        0.40733067     -0.41322125
## labour_force_2016                         -0.28974984      0.99831404
## labour_force_2019                         -0.29032730      0.99644177
## unemployment_2016                          0.08257531     -0.01572419
## unemployment_2019                          0.07189625     -0.03947862
## police_shootings_armed_2017               -0.04778249      0.81166650
## police_shootings_armed_2019               -0.07944646      0.80382662
## police_shootings_unarmed_2017             -0.05178705      0.45458448
## police_shootings_unarmed_2019             -0.03939005      0.48937004
##                               population_2019 white_pct_2016 white_pct_2019
## mask_pct_compliance                0.36563426    -0.15797689    -0.16631879
## norm_cases_avg                     0.05484626    -0.24718559    -0.23639077
## norm_deaths_covid_avg              0.07017525    -0.29399492    -0.28618408
## norm_deaths_assault_avg            0.14802758    -0.72210810    -0.70963000
## norm_deaths_suicide_avg           -0.28988959     0.27246084     0.28048127
## population_2016                    0.99964016    -0.22616779    -0.22677114
## population_2019                    1.00000000    -0.22532253    -0.22621196
## white_pct_2016                    -0.22532253     1.00000000     0.99913437
## white_pct_2019                    -0.22621196     0.99913437     1.00000000
## hispanic_pct_2016                  0.30341795     0.11117527     0.11513228
## hispanic_pct_2019                  0.30122512     0.11199033     0.11577665
## afra_black_pct_2016                0.10895756    -0.87853309    -0.87326796
## afra_black_pct_2019                0.10515881    -0.87607451    -0.87198409
## republican_pct_2016               -0.42210567     0.48263136     0.48091889
## republican_pct_2020               -0.41346549     0.50286222     0.50343694
## labour_force_2016                  0.99783673    -0.23048713    -0.23171575
## labour_force_2019                  0.99693342    -0.22443856    -0.22569504
## unemployment_2016                 -0.01969032    -0.15678464    -0.14633761
## unemployment_2019                 -0.04354953    -0.14099804    -0.13384893
## police_shootings_armed_2017        0.81349801    -0.16328840    -0.15985703
## police_shootings_armed_2019        0.80792794    -0.15569882    -0.15393912
## police_shootings_unarmed_2017      0.45369077    -0.11352512    -0.11037481
## police_shootings_unarmed_2019      0.49044635    -0.06753537    -0.06644905
##                               hispanic_pct_2016 hispanic_pct_2019
## mask_pct_compliance                  0.51614033        0.51875665
## norm_cases_avg                       0.23869146        0.23936841
## norm_deaths_covid_avg                0.26762922        0.26676682
## norm_deaths_assault_avg             -0.03226058       -0.03488804
## norm_deaths_suicide_avg             -0.30956084       -0.31173974
## population_2016                      0.30045896        0.29813545
## population_2019                      0.30341795        0.30122512
## white_pct_2016                       0.11117527        0.11199033
## white_pct_2019                       0.11513228        0.11577665
## hispanic_pct_2016                    1.00000000        0.99955237
## hispanic_pct_2019                    0.99955237        1.00000000
## afra_black_pct_2016                 -0.19663869       -0.19530662
## afra_black_pct_2019                 -0.20154811       -0.19996377
## republican_pct_2016                 -0.26478400       -0.25928515
## republican_pct_2020                 -0.21123009       -0.20653830
## labour_force_2016                    0.28118301        0.27860803
## labour_force_2019                    0.28785782        0.28540588
## unemployment_2016                    0.37518114        0.37752456
## unemployment_2019                    0.33169207        0.33292433
## police_shootings_armed_2017          0.19809566        0.19712232
## police_shootings_armed_2019          0.24168617        0.23839674
## police_shootings_unarmed_2017        0.18589117        0.18188740
## police_shootings_unarmed_2019        0.15892164        0.15836909
##                               afra_black_pct_2016 afra_black_pct_2019
## mask_pct_compliance                   0.073225796         0.074715066
## norm_cases_avg                        0.310068205         0.306229942
## norm_deaths_covid_avg                 0.310767838         0.305949123
## norm_deaths_assault_avg               0.777709217         0.770211659
## norm_deaths_suicide_avg              -0.275746492        -0.278227900
## population_2016                       0.110471285         0.106515387
## population_2019                       0.108957558         0.105158809
## white_pct_2016                       -0.878533088        -0.876074511
## white_pct_2019                       -0.873267959        -0.871984086
## hispanic_pct_2016                    -0.196638690        -0.201548112
## hispanic_pct_2019                    -0.195306620        -0.199963771
## afra_black_pct_2016                   1.000000000         0.999414685
## afra_black_pct_2019                   0.999414685         1.000000000
## republican_pct_2016                  -0.372090962        -0.365228057
## republican_pct_2020                  -0.403761807        -0.398979253
## labour_force_2016                     0.112291911         0.108556788
## labour_force_2019                     0.105370122         0.101601141
## unemployment_2016                     0.088522689         0.081566449
## unemployment_2019                     0.089801010         0.086612168
## police_shootings_armed_2017           0.073908250         0.069124038
## police_shootings_armed_2019           0.086679402         0.084276202
## police_shootings_unarmed_2017         0.044705876         0.039891491
## police_shootings_unarmed_2019        -0.007777714        -0.009761947
##                               republican_pct_2016 republican_pct_2020
## mask_pct_compliance                   -0.52928282        -0.548642838
## norm_cases_avg                         0.02957923         0.079201582
## norm_deaths_covid_avg                 -0.16761899        -0.108096773
## norm_deaths_assault_avg               -0.29883481        -0.292479696
## norm_deaths_suicide_avg                0.37621202         0.407330666
## population_2016                       -0.42279204        -0.413221245
## population_2019                       -0.42210567        -0.413465491
## white_pct_2016                         0.48263136         0.502862224
## white_pct_2019                         0.48091889         0.503436937
## hispanic_pct_2016                     -0.26478400        -0.211230090
## hispanic_pct_2019                     -0.25928515        -0.206538304
## afra_black_pct_2016                   -0.37209096        -0.403761807
## afra_black_pct_2019                   -0.36522806        -0.398979253
## republican_pct_2016                    1.00000000         0.976694951
## republican_pct_2020                    0.97669495         1.000000000
## labour_force_2016                     -0.43180880        -0.424946084
## labour_force_2019                     -0.42776495        -0.420921252
## unemployment_2016                     -0.01669792         0.052341992
## unemployment_2019                     -0.06891462        -0.009576923
## police_shootings_armed_2017           -0.29648304        -0.302365578
## police_shootings_armed_2019           -0.28284927        -0.299513707
## police_shootings_unarmed_2017         -0.18306944        -0.186440639
## police_shootings_unarmed_2019         -0.17212198        -0.175683546
##                               labour_force_2016 labour_force_2019
## mask_pct_compliance                  0.36167434        0.36250226
## norm_cases_avg                       0.04793362        0.04662571
## norm_deaths_covid_avg                0.06544157        0.05927223
## norm_deaths_assault_avg              0.14395667        0.13562151
## norm_deaths_suicide_avg             -0.28974984       -0.29032730
## population_2016                      0.99831404        0.99644177
## population_2019                      0.99783673        0.99693342
## white_pct_2016                      -0.23048713       -0.22443856
## white_pct_2019                      -0.23171575       -0.22569504
## hispanic_pct_2016                    0.28118301        0.28785782
## hispanic_pct_2019                    0.27860803        0.28540588
## afra_black_pct_2016                  0.11229191        0.10537012
## afra_black_pct_2019                  0.10855679        0.10160114
## republican_pct_2016                 -0.43180880       -0.42776495
## republican_pct_2020                 -0.42494608       -0.42092125
## labour_force_2016                    1.00000000        0.99766865
## labour_force_2019                    0.99766865        1.00000000
## unemployment_2016                   -0.04007297       -0.04452585
## unemployment_2019                   -0.05958353       -0.06656403
## police_shootings_armed_2017          0.80504485        0.81105989
## police_shootings_armed_2019          0.79717569        0.80312119
## police_shootings_unarmed_2017        0.45626247        0.45905557
## police_shootings_unarmed_2019        0.48789620        0.49370649
##                               unemployment_2016 unemployment_2019
## mask_pct_compliance                  0.08457656       0.118224325
## norm_cases_avg                       0.15024747       0.159081241
## norm_deaths_covid_avg                0.29552998       0.315670518
## norm_deaths_assault_avg              0.35261697       0.358719533
## norm_deaths_suicide_avg              0.08257531       0.071896252
## population_2016                     -0.01572419      -0.039478620
## population_2019                     -0.01969032      -0.043549530
## white_pct_2016                      -0.15678464      -0.140998035
## white_pct_2019                      -0.14633761      -0.133848934
## hispanic_pct_2016                    0.37518114       0.331692072
## hispanic_pct_2019                    0.37752456       0.332924330
## afra_black_pct_2016                  0.08852269       0.089801010
## afra_black_pct_2019                  0.08156645       0.086612168
## republican_pct_2016                 -0.01669792      -0.068914621
## republican_pct_2020                  0.05234199      -0.009576923
## labour_force_2016                   -0.04007297      -0.059583527
## labour_force_2019                   -0.04452585      -0.066564032
## unemployment_2016                    1.00000000       0.893681597
## unemployment_2019                    0.89368160       1.000000000
## police_shootings_armed_2017          0.04639305       0.046895644
## police_shootings_armed_2019         -0.01588018      -0.015073580
## police_shootings_unarmed_2017        0.05131676       0.016445653
## police_shootings_unarmed_2019        0.07989409       0.112107465
##                               police_shootings_armed_2017
## mask_pct_compliance                            0.20739337
## norm_cases_avg                                 0.06176752
## norm_deaths_covid_avg                          0.01060301
## norm_deaths_assault_avg                        0.20134869
## norm_deaths_suicide_avg                       -0.04778249
## population_2016                                0.81166650
## population_2019                                0.81349801
## white_pct_2016                                -0.16328840
## white_pct_2019                                -0.15985703
## hispanic_pct_2016                              0.19809566
## hispanic_pct_2019                              0.19712232
## afra_black_pct_2016                            0.07390825
## afra_black_pct_2019                            0.06912404
## republican_pct_2016                           -0.29648304
## republican_pct_2020                           -0.30236558
## labour_force_2016                              0.80504485
## labour_force_2019                              0.81105989
## unemployment_2016                              0.04639305
## unemployment_2019                              0.04689564
## police_shootings_armed_2017                    1.00000000
## police_shootings_armed_2019                    0.77483528
## police_shootings_unarmed_2017                  0.33731824
## police_shootings_unarmed_2019                  0.53540965
##                               police_shootings_armed_2019
## mask_pct_compliance                            0.23739770
## norm_cases_avg                                 0.06889112
## norm_deaths_covid_avg                          0.01784940
## norm_deaths_assault_avg                        0.14996742
## norm_deaths_suicide_avg                       -0.07944646
## population_2016                                0.80382662
## population_2019                                0.80792794
## white_pct_2016                                -0.15569882
## white_pct_2019                                -0.15393912
## hispanic_pct_2016                              0.24168617
## hispanic_pct_2019                              0.23839674
## afra_black_pct_2016                            0.08667940
## afra_black_pct_2019                            0.08427620
## republican_pct_2016                           -0.28284927
## republican_pct_2020                           -0.29951371
## labour_force_2016                              0.79717569
## labour_force_2019                              0.80312119
## unemployment_2016                             -0.01588018
## unemployment_2019                             -0.01507358
## police_shootings_armed_2017                    0.77483528
## police_shootings_armed_2019                    1.00000000
## police_shootings_unarmed_2017                  0.36878310
## police_shootings_unarmed_2019                  0.47003045
##                               police_shootings_unarmed_2017
## mask_pct_compliance                              0.14465853
## norm_cases_avg                                   0.03659297
## norm_deaths_covid_avg                            0.02287339
## norm_deaths_assault_avg                          0.16120462
## norm_deaths_suicide_avg                         -0.05178705
## population_2016                                  0.45458448
## population_2019                                  0.45369077
## white_pct_2016                                  -0.11352512
## white_pct_2019                                  -0.11037481
## hispanic_pct_2016                                0.18589117
## hispanic_pct_2019                                0.18188740
## afra_black_pct_2016                              0.04470588
## afra_black_pct_2019                              0.03989149
## republican_pct_2016                             -0.18306944
## republican_pct_2020                             -0.18644064
## labour_force_2016                                0.45626247
## labour_force_2019                                0.45905557
## unemployment_2016                                0.05131676
## unemployment_2019                                0.01644565
## police_shootings_armed_2017                      0.33731824
## police_shootings_armed_2019                      0.36878310
## police_shootings_unarmed_2017                    1.00000000
## police_shootings_unarmed_2019                    0.22019501
##                               police_shootings_unarmed_2019
## mask_pct_compliance                             0.139061876
## norm_cases_avg                                 -0.024937951
## norm_deaths_covid_avg                           0.022954593
## norm_deaths_assault_avg                         0.083172597
## norm_deaths_suicide_avg                        -0.039390048
## population_2016                                 0.489370038
## population_2019                                 0.490446347
## white_pct_2016                                 -0.067535373
## white_pct_2019                                 -0.066449051
## hispanic_pct_2016                               0.158921640
## hispanic_pct_2019                               0.158369092
## afra_black_pct_2016                            -0.007777714
## afra_black_pct_2019                            -0.009761947
## republican_pct_2016                            -0.172121979
## republican_pct_2020                            -0.175683546
## labour_force_2016                               0.487896199
## labour_force_2019                               0.493706491
## unemployment_2016                               0.079894089
## unemployment_2019                               0.112107465
## police_shootings_armed_2017                     0.535409652
## police_shootings_armed_2019                     0.470030454
## police_shootings_unarmed_2017                   0.220195007
## police_shootings_unarmed_2019                   1.000000000

We’re going to plot these correlations with a heat map to better visualize.

#cor(na.omit(data_counties[3:25])) %>% add_histogram2d(colorscale = "Blues")

Anddd… Let’s get into some plotting!

# clean the counties data for this chart
counties <- data_counties %>% filter(!is.na(norm_cases_avg)) %>% filter(!is.na(mask_pct_compliance)) %>% ungroup()
# compute regressions and correlations
regression <- lm(norm_cases_avg ~ mask_pct_compliance, data = counties)
correlation <- rcorr(data_counties$mask_pct_compliance, data_counties$norm_cases_avg)

# build chart
counties %>%
  plot_ly(x = ~mask_pct_compliance) %>% 
  add_markers(y = ~norm_cases_avg) %>% 
  add_lines(x = ~mask_pct_compliance, y = fitted(regression)) %>%
  layout(title = paste0("COVID-19 Cases by Mask Compliance (r = ",
                        round(correlation$r["x","y"], 3), ", p = ",
                        round(correlation$P["x","y"], 3), ")"),
         xaxis = list(title = "Mask Compliance %"),
         yaxis = list(title = "Average Cases %"),
         showlegend = FALSE)
rm(counties)
rm(regression)
rm(correlation)
# clean the counties data for this chart
counties <- data_counties %>% filter(!is.na(norm_cases_avg)) %>% filter(!is.na(white_pct_2016))  %>% ungroup()
# compute regressions and correlations
regression <- lm(norm_cases_avg ~ white_pct_2016, data = counties)
correlation <- rcorr(data_counties$white_pct_2016, data_counties$norm_cases_avg)

# build chart
counties %>%
  plot_ly(x = ~white_pct_2016) %>% 
  add_markers(y = ~norm_cases_avg) %>% 
  add_lines(x = ~white_pct_2016, y = fitted(regression)) %>%
  layout(title = paste0("COVID-19 Cases by Demographics (r = ",
                        round(correlation$r["x","y"], 3), ", p = ",
                        round(correlation$P["x","y"], 3), ")"),
         xaxis = list(title = "White % (2016)"),
         yaxis = list(title = "Average Cases %"),
         showlegend = FALSE)
rm(counties)
rm(regression)
rm(correlation)
# clean the counties data for this chart
counties <- data_counties %>% filter(!is.na(norm_cases_avg)) %>% filter(!is.na(republican_pct_2016)) %>% ungroup()
# compute regressions and correlations
regression <- lm(norm_cases_avg ~ republican_pct_2016, data = counties)
correlation <- rcorr(data_counties$republican_pct_2016, data_counties$norm_cases_avg)

# build chart
counties %>%
  plot_ly(x = ~republican_pct_2016) %>% 
  add_markers(y = ~norm_cases_avg) %>% 
  add_lines(x = ~republican_pct_2016, y = fitted(regression)) %>%
  layout(title = paste0("COVID-19 Cases by Political Affiliation (r = ",
                        round(correlation$r["x","y"], 3), ", p = ",
                        round(correlation$P["x","y"], 3), ")"),
         xaxis = list(title = "Republican Voters % (2016)"),
         yaxis = list(title = "Average Cases %"),
         showlegend = FALSE)
rm(counties)
rm(regression)
rm(correlation)
# clean the counties data for this chart
counties <- data_counties %>% filter(!is.na(white_pct_2016)) %>% filter(!is.na(mask_pct_compliance)) %>% ungroup()
# compute regressions and correlations
regression <- lm(mask_pct_compliance ~ white_pct_2016, data = counties)
correlation <- rcorr(data_counties$white_pct_2016, data_counties$mask_pct_compliance)

# build chart
counties %>%
  plot_ly(x = ~white_pct_2016) %>% 
  add_markers(y = ~mask_pct_compliance) %>% 
  add_lines(x = ~white_pct_2016, y = fitted(regression)) %>%
  layout(title = paste0("Mask Compliance by Demographics (r = ",
                        round(correlation$r["x","y"], 3), ", p = ",
                        round(correlation$P["x","y"], 3), ")"),
         xaxis = list(title = "White % (2016)"),
         yaxis = list(title = "Mask Compliance %"),
         showlegend = FALSE)
rm(counties)
rm(regression)
rm(correlation)
# clean the counties data for this chart
counties <- data_counties %>% filter(!is.na(republican_pct_2016)) %>%
  filter(!is.na(mask_pct_compliance)) %>% ungroup()
# compute regressions and correlations
regression <- lm(mask_pct_compliance ~ republican_pct_2016, data = counties)
correlation <- rcorr(data_counties$republican_pct_2016, data_counties$mask_pct_compliance)

# build chart
counties %>%
  plot_ly(x = ~republican_pct_2016) %>% 
  add_markers(y = ~mask_pct_compliance) %>% 
  add_lines(x = ~republican_pct_2016, y = fitted(regression)) %>%
  layout(title = paste0("Mask Compliance by Political Affiliation (r = ",
                        round(correlation$r["x","y"], 3), ", p = ",
                        round(correlation$P["x","y"], 3), ")"),
         xaxis = list(title = "Republican Voters % (2016)"),
         yaxis = list(title = "Mask Compliance %"),
         showlegend = FALSE)
rm(counties)
rm(regression)
rm(correlation)
# clean the counties data for this chart
counties <- data_counties %>% filter(!is.na(white_pct_2016)) %>%
  filter(!is.na(republican_pct_2016)) %>% ungroup()
# compute regressions and correlations
regression <- lm(republican_pct_2016 ~ white_pct_2016, data = counties)
correlation <- rcorr(data_counties$white_pct_2016, data_counties$republican_pct_2016)

# build chart
counties %>%
  plot_ly(x = ~white_pct_2016) %>% 
  add_markers(y = ~republican_pct_2016) %>% 
  add_lines(x = ~white_pct_2016, y = fitted(regression)) %>%
  layout(title = paste0("Political Affiliation by Demographics (r = ",
                        round(correlation$r["x","y"], 3), ", p = ",
                        round(correlation$P["x","y"], 3), ")"),
         xaxis = list(title = "White % (2016)"),
         yaxis = list(title = "Republican Voters % (2016)"),
         showlegend = FALSE)
rm(counties)
rm(regression)
rm(correlation)